home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / dejagnu.lha / dejagnu-1.0.1 / expect / exp_main_tk.c < prev    next >
C/C++ Source or Header  |  1993-04-26  |  15KB  |  595 lines
  1. /* exp_main_tk.c - main for expectk
  2.  
  3. This is "main.c" from the Tk distribution with some minor modifications to
  4. support Expect.
  5.  
  6. Don Libes, NIST, 12/19/92
  7.  
  8. */
  9.  
  10.  
  11. /* 
  12.  * main.c --
  13.  *
  14.  *    This file contains the main program for "wish", a windowing
  15.  *    shell based on Tk and Tcl.  It also provides a template that
  16.  *    can be used as the basis for main programs for other Tk
  17.  *    applications.
  18.  *
  19.  * Copyright 1990-1992 Regents of the University of California.
  20.  * Permission to use, copy, modify, and distribute this
  21.  * software and its documentation for any purpose and without
  22.  * fee is hereby granted, provided that the above copyright
  23.  * notice appear in all copies.  The University of California
  24.  * makes no representations about the suitability of this
  25.  * software for any purpose.  It is provided "as is" without
  26.  * express or implied warranty.
  27.  */
  28.  
  29. #ifndef lint
  30. static char rcsid[] = "$Header: /rel/cvsfiles/devo/expect/exp_main_tk.c,v 1.7 1993/04/26 22:54:47 rob Exp $ SPRITE (Berkeley)";
  31. #endif
  32.  
  33. #include "tkConfig.h"
  34. #include "tkInt.h"
  35.  
  36. #ifdef TK_EXTENDED
  37. #    include "tclExtend.h"
  38. Tcl_Interp *tk_mainInterp;  /* Need to process signals */
  39. #endif
  40.  
  41. #include "exp_main.h"
  42.  
  43. /*
  44.  * Declarations for library procedures:
  45.  */
  46.  
  47. extern int isatty();
  48.  
  49. /*
  50.  * Command used to initialize wish:
  51.  */
  52.  
  53. #ifdef TK_EXTENDED
  54. static char initCmd[] = "load wishx.tcl";
  55. #else
  56. static char initCmd[] = "source $tk_library/wish.tcl";
  57. #endif
  58.  
  59. /*
  60.  * Global variables used by the main program:
  61.  */
  62.  
  63. static Tk_Window w;        /* The main window for the application.  If
  64.                  * NULL then the application no longer
  65.                  * exists. */
  66. static Tcl_Interp *interp;    /* Interpreter for this application. */
  67. static int x, y;        /* Coordinates of last location moved to;
  68.                  * used by "moveto" and "lineto" commands. */
  69. static Tcl_CmdBuf buffer;    /* Used to assemble lines of terminal input
  70.                  * into Tcl commands. */
  71. static int tty;            /* Non-zero means standard input is a
  72.                  * terminal-like device.  Zero means it's
  73.                  * a file. */
  74.  
  75. /*
  76.  * Command-line options:
  77.  */
  78.  
  79. int synchronize = 0;
  80. char *fileName = NULL;
  81. char *name = NULL;
  82. char *display = NULL;
  83. char *geometry = NULL;
  84.  
  85. /* for Expect */
  86. int my_rc = 1;
  87. int sys_rc = 1;
  88. int optcmd_eval();
  89.  
  90. Tk_ArgvInfo argTable[] = {
  91.     {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
  92.     "File from which to read commands"},
  93.     {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
  94.     "Initial geometry for window"},
  95.     {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
  96.     "Display to use"},
  97.     {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
  98.     "Name to use for application"},
  99.     {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
  100.     "Use synchronous mode for display server"},
  101.  
  102. /* for Expect */
  103.     {"-command", TK_ARGV_GENFUNC, (char *) optcmd_eval, (char *) &name,
  104.     "Command(s) to execute immediately"},
  105.     {"-debug", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_is_debugging,
  106.     "Turn on debugging"},
  107.     {"-interactive", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_interactive,
  108.     "Interactive mode"},
  109.     {"-norc", TK_ARGV_CONSTANT, (char *) 0, (char *) &my_rc,
  110.     "Don't read ~/.expect.rc"},
  111.     {"-NORC", TK_ARGV_CONSTANT, (char *) 0, (char *) &sys_rc,
  112.     "Don't read system-wide expect.rc"},
  113.  
  114.     {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
  115.     (char *) NULL}
  116. };
  117.  
  118. /*ARGSUSED*/
  119. int
  120. optcmd_eval(dst,interp,key,argc,argv)
  121. char *dst;
  122. Tcl_Interp *interp;
  123. char *key;
  124. int argc;
  125. char **argv;
  126. {
  127.     int i;
  128.     int rc;
  129.  
  130.     exp_cmdlinecmds = 1;
  131.  
  132.     rc = Tcl_Eval(interp,argv[0],0,(char **)0);
  133.  
  134.     argc--;
  135.     for (i=0;i<argc;i++) {
  136.         argv[i] = argv[i+1];
  137.     }
  138.  
  139.     return(rc == TCL_ERROR?TCL_ERROR:argc);
  140. }
  141.  
  142. /*
  143.  * Declaration for Tcl command procedure to create demo widget.  This
  144.  * procedure is only invoked if SQUARE_DEMO is defined.
  145.  */
  146.  
  147. extern int Tk_SquareCmd _ANSI_ARGS_((ClientData clientData,
  148.     Tcl_Interp *interp, int argc, char **argv));
  149.  
  150. /*
  151.  * Forward declarations for procedures defined later in this file:
  152.  */
  153.  
  154. static void        DelayedMap _ANSI_ARGS_((ClientData clientData));
  155. static int        LinetoCmd _ANSI_ARGS_((ClientData clientData,
  156.                 Tcl_Interp *interp, int argc, char **argv));
  157. static int        MovetoCmd _ANSI_ARGS_((ClientData clientData,
  158.                 Tcl_Interp *interp, int argc, char **argv));
  159. static void        StdinProc _ANSI_ARGS_((ClientData clientData,
  160.                 int mask));
  161. static void        StructureProc _ANSI_ARGS_((ClientData clientData,
  162.                 XEvent *eventPtr));
  163.  
  164. /*
  165.  *----------------------------------------------------------------------
  166.  *
  167.  * main --
  168.  *
  169.  *    Main program for Wish.
  170.  *
  171.  * Results:
  172.  *    None. This procedure never returns (it exits the process when
  173.  *    it's done
  174.  *
  175.  * Side effects:
  176.  *    This procedure initializes the wish world and then starts
  177.  *    interpreting commands;  almost anything could happen, depending
  178.  *    on the script being interpreted.
  179.  *
  180.  *----------------------------------------------------------------------
  181.  */
  182.  
  183. int
  184. main(argc, argv)
  185.     int argc;                /* Number of arguments. */
  186.     char **argv;            /* Array of argument strings. */
  187. {
  188.     char *args, *p, *msg;
  189.     char buf[20];
  190.     int result;
  191.     Tk_3DBorder border;
  192.     extern char *exp_argv0;
  193.  
  194. #ifdef TK_EXTENDED
  195.     tk_mainInterp = interp = Tcl_CreateExtendedInterp();
  196. #else
  197.     interp = Tcl_CreateInterp();
  198. #endif
  199. #ifdef TCL_MEM_DEBUG
  200.     Tcl_InitMemory(interp);
  201. #endif
  202.  
  203.     exp_init(interp);
  204.     exp_argv0 = argv[0];
  205.  
  206.     /*
  207.      * Parse command-line arguments.
  208.      */
  209.  
  210.     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
  211.         != TCL_OK) {
  212.     fprintf(stderr, "%s\n", interp->result);
  213.     exit(1);
  214.     }
  215.  
  216.     if (!fileName) fileName = argv[1];
  217.  
  218.     if (name == NULL) {
  219.     if (fileName != NULL) {
  220.         p = fileName;
  221.     } else {
  222.         p = argv[0];
  223.     }
  224.     name = strrchr(p, '/');
  225.     if (name != NULL) {
  226.         name++;
  227.     } else {
  228.         name = p;
  229.     }
  230.     }
  231.  
  232.   /* if user hasn't explicitly requested we be interactive */
  233.   /* look for a file or some other source of commands */
  234.     if (fileName && !exp_interactive) {
  235.     if (0 == strcmp(fileName,"-")) {
  236.         exp_cmdfile = stdin;
  237.     } else if (NULL == (exp_cmdfile = fopen(fileName,"r"))) {
  238.         perror(fileName);
  239.         exp_exit(interp,-1);
  240.     }
  241.     } else if (!exp_cmdlinecmds) {
  242.     /* no other source of commands, force interactive */
  243.     exp_interactive = 1;
  244.     }
  245.  
  246.     exp_interpret_rcfiles(interp,my_rc,sys_rc);
  247.  
  248.     /*
  249.      * Initialize the Tk application and arrange to map the main window
  250.      * after the startup script has been executed, if any.  This way
  251.      * the script can withdraw the window so it isn't ever mapped
  252.      * at all.
  253.      */
  254.  
  255.     w = Tk_CreateMainWindow(interp, display, name);
  256.     if (w == NULL) {
  257.     fprintf(stderr, "%s\n", interp->result);
  258.     exit(1);
  259.     }
  260.     Tk_SetClass(w, "Tk");
  261.     Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
  262.         (ClientData) NULL);
  263.     Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
  264.     if (synchronize) {
  265.     XSynchronize(Tk_Display(w), True);
  266.     }
  267.     Tk_GeometryRequest(w, 200, 200);
  268.     border = Tk_Get3DBorder(interp, w, None, "#ffe4c4");
  269.     if (border == NULL) {
  270.     Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
  271.     Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
  272.     } else {
  273.     Tk_SetBackgroundFromBorder(w, border);
  274.     }
  275.     XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
  276.         BlackPixelOfScreen(Tk_Screen(w)));
  277.  
  278.     /*
  279.      * Make command-line arguments available in the Tcl variables "argc"
  280.      * and "argv".  Also set the "geometry" variable from the geometry
  281.      * specified on the command line.
  282.      */
  283.  
  284.     args = Tcl_Merge(argc-1, argv+1);
  285.     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  286.     ckfree(args);
  287.     sprintf(buf, "%d", argc-1);
  288.     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  289.     if (geometry != NULL) {
  290.     Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
  291.     }
  292.  
  293.     /*
  294.      * Add a few application-specific commands to the application's
  295.      * interpreter.
  296.      */
  297.  
  298.     Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) w,
  299.         (void (*)()) NULL);
  300.     Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) w,
  301.         (void (*)()) NULL);
  302. #ifdef SQUARE_DEMO
  303.     Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData) w,
  304.         (void (*)()) NULL);
  305. #endif
  306.  
  307.     /*
  308.      * Execute Wish's initialization script, followed by the script specified
  309.      * on the command line, if any.
  310.      */
  311.  
  312. #ifdef TK_EXTENDED
  313.      tclAppName    = "Wish";
  314.      tclAppLongname = "Wish - Tk Shell";
  315.      tclAppVersion  = TK_VERSION;
  316.      Tcl_ShellEnvInit (interp, TCLSH_ABORT_STARTUP_ERR,
  317.         name,
  318.         0, NULL,       /* argv var already set  */
  319.         fileName == NULL,  /* interactive?        */
  320.         NULL);           /* Standard default file */
  321. #endif
  322.  
  323.     result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
  324.     if (result != TCL_OK) {
  325.     goto error;
  326.     }
  327.  
  328.     /* become interactive if requested or "nothing to do" */
  329.     if (exp_interactive) {
  330.         (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  331.         (void) exp_interpreter(interp);
  332.     } else if (exp_cmdfile) {
  333.         exp_interpret_cmdfile(interp,exp_cmdfile);
  334.         (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  335.         Tk_MainLoop();
  336.     }
  337.  
  338. #if 0
  339.     if (exp_interactive || (!fileName && !exp_cmdlinecmds)) {
  340.         (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  341.         (void) exp_interpreter(interp);
  342.     }
  343.  
  344.     if (exp_cmdfile) {
  345.         exp_interpret_cmdfile(interp,exp_cmdfile);
  346.         (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  347.         Tk_MainLoop();
  348.     }
  349. #endif
  350.  
  351.     exp_exit(interp,0);
  352.  
  353. #if 0
  354.     tty = isatty(0);
  355.     if (fileName != NULL) {
  356.     result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
  357.     if (result != TCL_OK) {
  358.         goto error;
  359.     }
  360.     tty = 0;
  361.     } else {
  362.     /*
  363.      * Commands will come from standard input.  Set up a handler
  364.      * to receive those characters and print a prompt if the input
  365.      * device is a terminal.
  366.      */
  367.  
  368.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  369.     if (tty) {
  370.         printf("wish: ");
  371.     }
  372.     }
  373.     fflush(stdout);
  374.     buffer = Tcl_CreateCmdBuf();
  375.     (void) Tcl_Eval(interp, "update", 0, (char **) NULL);
  376.  
  377.     /*
  378.      * Loop infinitely, waiting for commands to execute.  When there
  379.      * are no windows left, Tk_MainLoop returns and we clean up and
  380.      * exit.
  381.      */
  382.  
  383.     Tk_MainLoop();
  384.     Tcl_DeleteInterp(interp);
  385.     Tcl_DeleteCmdBuf(buffer);
  386.     exit(0);
  387. #endif
  388.  
  389. error:
  390.     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  391.     if (msg == NULL) {
  392.     msg = interp->result;
  393.     }
  394.     fprintf(stderr, "%s\n", msg);
  395.     Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
  396.     exit(1);
  397.     return 0;            /* Needed only to prevent compiler warnings. */
  398. }
  399.  
  400. #if 0
  401. /*
  402.  *----------------------------------------------------------------------
  403.  *
  404.  * StdinProc --
  405.  *
  406.  *    This procedure is invoked by the event dispatcher whenever
  407.  *    standard input becomes readable.  It grabs the next line of
  408.  *    input characters, adds them to a command being assembled, and
  409.  *    executes the command if it's complete.
  410.  *
  411.  * Results:
  412.  *    None.
  413.  *
  414.  * Side effects:
  415.  *    Could be almost arbitrary, depending on the command that's
  416.  *    typed.
  417.  *
  418.  *----------------------------------------------------------------------
  419.  */
  420.  
  421.     /* ARGSUSED */
  422. static void
  423. StdinProc(clientData, mask)
  424.     ClientData clientData;        /* Not used. */
  425.     int mask;                /* Not used. */
  426. {
  427. #define BUFFER_SIZE 4000
  428.     char input[BUFFER_SIZE+1];
  429.     static int gotPartial = 0;
  430.     char *cmd;
  431.     int result, count;
  432.  
  433.     count = read(fileno(stdin), input, BUFFER_SIZE);
  434.     if (count <= 0) {
  435.     if (!gotPartial) {
  436.         if (tty) {
  437.         Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
  438.         exit(0);
  439.         } else {
  440.         Tk_DeleteFileHandler(0);
  441.         }
  442.         return;
  443.     } else {
  444.         input[0] = 0;
  445.     }
  446.     } else {
  447.     input[count] = 0;
  448.     cmd = Tcl_AssembleCmd(buffer, input);
  449.     if (cmd == NULL) {
  450.     gotPartial = 1;
  451.     return;
  452.     }
  453.     gotPartial = 0;
  454.     result = Tcl_RecordAndEval(interp, cmd, 0);
  455.     if (*interp->result != 0) {
  456.     if ((result != TCL_OK) || (tty)) {
  457.         printf("%s\n", interp->result);
  458.     }
  459.     }
  460.     if (tty) {
  461.     printf("wish: ");
  462.     fflush(stdout);
  463.     }
  464. }
  465. #endif
  466.  
  467. /*
  468.  *----------------------------------------------------------------------
  469.  *
  470.  * StructureProc --
  471.  *
  472.  *    This procedure is invoked whenever a structure-related event
  473.  *    occurs on the main window.  If the window is deleted, the
  474.  *    procedure modifies "w" to record that fact.
  475.  *
  476.  * Results:
  477.  *    None.
  478.  *
  479.  * Side effects:
  480.  *    Variable "w" may get set to NULL.
  481.  *
  482.  *----------------------------------------------------------------------
  483.  */
  484.  
  485.     /* ARGSUSED */
  486. static void
  487. StructureProc(clientData, eventPtr)
  488.     ClientData clientData;    /* Information about window. */
  489.     XEvent *eventPtr;        /* Information about event. */
  490. {
  491.     if (eventPtr->type == DestroyNotify) {
  492.     w = NULL;
  493.     }
  494. }
  495.  
  496. /*
  497.  *----------------------------------------------------------------------
  498.  *
  499.  * DelayedMap --
  500.  *
  501.  *    This procedure is invoked by the event dispatcher once the
  502.  *    startup script has been processed.  It waits for all other
  503.  *    pending idle handlers to be processed (so that all the
  504.  *    geometry information will be correct), then maps the
  505.  *    application's main window.
  506.  *
  507.  * Results:
  508.  *    None.
  509.  *
  510.  * Side effects:
  511.  *    The main window gets mapped.
  512.  *
  513.  *----------------------------------------------------------------------
  514.  */
  515.  
  516.     /* ARGSUSED */
  517. static void
  518. DelayedMap(clientData)
  519.     ClientData clientData;    /* Not used. */
  520. {
  521.  
  522.     while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
  523.     /* Empty loop body. */
  524.     }
  525.     if (w == NULL) {
  526.     return;
  527.     }
  528.     Tk_MapWindow(w);
  529. }
  530.  
  531. /*
  532.  *----------------------------------------------------------------------
  533.  *
  534.  * MoveToCmd and LineToCmd --
  535.  *
  536.  *    This procedures are registered as the command procedures for
  537.  *    "moveto" and "lineto" Tcl commands.  They provide a trivial
  538.  *    drawing facility.  They don't really work right, in that the
  539.  *    drawn information isn't persistent on the screen (it will go
  540.  *    away if the window is iconified and de-iconified again).  The
  541.  *    commands are here partly for testing and partly to illustrate
  542.  *    how to add application-specific commands to Tk.  You probably
  543.  *    shouldn't use these commands in any real scripts.
  544.  *
  545.  * Results:
  546.  *    The procedures return standard Tcl results.
  547.  *
  548.  * Side effects:
  549.  *    The screen gets modified.
  550.  *
  551.  *----------------------------------------------------------------------
  552.  */
  553.  
  554.     /* ARGSUSED */
  555. static int
  556. MovetoCmd(dummy, interp, argc, argv)
  557.     ClientData dummy;            /* Not used. */
  558.     Tcl_Interp *interp;            /* Current interpreter. */
  559.     int argc;                /* Number of arguments. */
  560.     char **argv;            /* Argument strings. */
  561. {
  562.     if (argc != 3) {
  563.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  564.         " x y\"", (char *) NULL);
  565.     return TCL_ERROR;
  566.     }
  567.     x = strtol(argv[1], (char **) NULL, 0);
  568.     y = strtol(argv[2], (char **) NULL, 0);
  569.     return TCL_OK;
  570. }
  571.     /* ARGSUSED */
  572. static int
  573. LinetoCmd(dummy, interp, argc, argv)
  574.     ClientData dummy;            /* Not used. */
  575.     Tcl_Interp *interp;            /* Current interpreter. */
  576.     int argc;                /* Number of arguments. */
  577.     char **argv;            /* Argument strings. */
  578. {
  579.     int newX, newY;
  580.  
  581.     if (argc != 3) {
  582.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  583.         " x y\"", (char *) NULL);
  584.     return TCL_ERROR;
  585.     }
  586.     newX = strtol(argv[1], (char **) NULL, 0);
  587.     newY = strtol(argv[2], (char **) NULL, 0);
  588.     Tk_MakeWindowExist(w);
  589.     XDrawLine(Tk_Display(w), Tk_WindowId(w),
  590.         DefaultGCOfScreen(Tk_Screen(w)), x, y, newX, newY);
  591.     x = newX;
  592.     y = newY;
  593.     return TCL_OK;
  594. }
  595.